home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Software Vault: The Gold Collection
/
Software Vault - The Gold Collection (American Databankers) (1993).ISO
/
cdr50
/
pbc22b.zip
/
PBC$BAS.ZIP
/
DINPUT.BAS
< prev
next >
Wrap
BASIC Source File
|
1993-03-26
|
3KB
|
111 lines
' +----------------------------------------------------------------------+
' | |
' | PBClone Copyright (c) 1990-1993 Thomas G. Hanlin III |
' | |
' +----------------------------------------------------------------------+
DECLARE SUB GetKbd (Ins%, Caps%, Num%, ScrollLock%)
DECLARE SUB GetVidMode (BIOSMode%, ScreenWidth%, ActivePage%)
DECLARE SUB NumFormat (FormatSt$, Number#, Result$)
DECLARE SUB SetKbd (BYVAL Ins%, BYVAL Caps%, BYVAL Num%, BYVAL ScrollLock%)
DECLARE SUB XQPrint (St$, BYVAL Row%, BYVAL Column%, BYVAL Attr%, BYVAL Page%, BYVAL Fast%)
DECLARE SUB GetSInput00 (FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%)
DECLARE SUB GetSInput01 (CurPosn%, FullExit%)
DECLARE SUB GetSInput02 (Capitalize%, TabExit%)
SUB DInput (FormatSt$, St&, St$, MinusOk%, Attr%, ExitCode%)
GetSInput00 FillCh%, ExitMode%, BadBeep%, FullBeep%, Fast%
GetSInput01 CurPosn%, FullExit%
GetSInput02 Capitalize%, TabExit%
ExitCode% = 0
MaxLen% = LEN(FormatSt$)
Row% = CSRLIN
Col% = POS(0)
GetVidMode BIOSMode%, ScreenWidth%, Page%
GetKbd Ins%, Caps%, Num%, ScrollLock%
SetKbd Ins%, Caps%, 1, ScrollLock%
DO
NumFormat FormatSt$, CDBL(St& / 100#), St$
XQPrint St$, Row%, Col%, Attr%, Page%, Fast%
DO
SetKbd Ins%, Caps%, 1, ScrollLock%
ky$ = INKEY$
LOOP UNTIL LEN(ky$)
IF LEN(ky$) = 2 THEN
GOSUB ExtendedKeys
ELSEIF ky$ < " " THEN
GOSUB ControlKeys
ELSE
GOSUB NormalKeys
END IF
LOOP UNTIL ExitCode%
NumFormat FormatSt$, CDBL(St& / 100#), St$
XQPrint St$, Row%, Col%, Attr%, Page%, Fast%
SetKbd Ins%, Caps%, Num%, ScrollLock%
EXIT SUB
' ------------ subroutines ----------------------------------------------------
ControlKeys:
SELECT CASE ASC(ky$)
CASE 3 ' ctrl C
IF ExitMode% THEN ExitCode% = -81
CASE 7, 8, 19 ' ctrl G, ctrl H, or ctrl S (backspace)
tmp$ = LTRIM$(STR$(St&))
St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
CASE 9 ' ctrl I (tab)
IF TabExit% THEN ExitCode% = 9
CASE 13 ' ctrl M (return)
ExitCode% = 13
CASE 18 ' ctrl R
IF ExitMode% THEN ExitCode% = -73
CASE 27 ' ctrl [ (esc)
ExitCode% = 27
CASE ELSE
END SELECT
RETURN
ExtendedKeys:
SELECT CASE ASC(RIGHT$(ky$, 1))
CASE 83 ' delete
tmp$ = LTRIM$(STR$(St&))
St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
CASE ELSE
IF ExitMode% THEN ExitCode% = -ASC(RIGHT$(ky$, 1))
END SELECT
RETURN
NormalKeys:
IF INSTR("0123456789-", ky$) THEN
OldSt& = St&
IF ky$ = "-" THEN
IF MinusOk% THEN
St& = -St&
ELSE
IF BadBeep% THEN BEEP
END IF
ELSE
St& = CLNG(VAL(STR$(St&) + ky$))
END IF
IF OldSt& <> St& THEN
NumFormat FormatSt$, CDBL(St& / 100#), St$
IF LEN(St$) > MaxLen% THEN
IF FullBeep% THEN BEEP
St& = OldSt&
END IF
END IF
ELSEIF ky$ = "." THEN
tmp$ = LTRIM$(STR$(St&))
St& = CLNG(VAL(LEFT$(tmp$, LEN(tmp$) - 1)))
ELSE
IF BadBeep% THEN BEEP
END IF
RETURN
END SUB